home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 029a / qbtree51.zip / DEMOQBT.BAS next >
BASIC Source File  |  1991-04-07  |  34KB  |  1,234 lines
  1. DECLARE SUB DoDeleteReadII ()
  2. DECLARE SUB DoAddReadII ()
  3. DECLARE SUB DoCreateOpenII ()
  4. DECLARE SUB DoCloseII ()
  5. DECLARE SUB DoDeleteReadI ()
  6. DECLARE SUB DoStoreReadI ()
  7. DECLARE SUB DoCloseI ()
  8. DECLARE SUB DoCreateOpenI ()
  9. DECLARE SUB DoDemo ()
  10. DECLARE SUB DoInitQBTREE ()
  11. DECLARE SUB ClearMsgArea ()
  12. DECLARE SUB ShowErrorMsg (stat%)
  13. DECLARE SUB DoAboutPg9 (row%, col%, rows%, cols%)
  14. DECLARE SUB DoAboutPg8 (row%, col%, rows%, cols%)
  15. DECLARE SUB DoAboutPg7 (row%, col%, rows%, cols%)
  16. DECLARE SUB DoAboutPg6 (row%, col%, rows%, cols%)
  17. DECLARE SUB DoAboutPg5 (row%, col%, rows%, cols%)
  18. DECLARE SUB DoAboutPg4 (row%, col%, rows%, cols%)
  19. DECLARE SUB DoAboutPg3 (row%, col%, rows%, cols%)
  20. DECLARE SUB DoAboutPg2 (row%, col%, rows%, cols%)
  21. DECLARE SUB DoAboutPg1 (row%, col%, rows%, cols%)
  22. DECLARE SUB DoAboutPg0 (row%, col%, rows%, cols%)
  23. DECLARE SUB DoAboutPages ()
  24. DECLARE SUB DelaySec (sec%)
  25. DECLARE SUB ShowMessage (msg$)
  26. DECLARE SUB GetWindow (row%, col%, rows%, cols%)
  27. DECLARE SUB PutWindow (row%, col%)
  28. DECLARE SUB ScrollWindow (row%, col%, rows%, cols%, dir%, lines%)
  29. DECLARE SUB DoTitleScreen ()
  30. DECLARE SUB MakeWindow (row%, col%, rows%, cols%, bg%)
  31. DECLARE FUNCTION Center% (strg$, col%, cols%)
  32. DECLARE FUNCTION SignalMessage% (msg$, waitfor%)
  33. DECLARE FUNCTION GetKey% (waitfor%)
  34.  
  35. DEFINT A-Z
  36.  
  37. TYPE RegTypex
  38. ax AS INTEGER
  39. bx AS INTEGER
  40. cx AS INTEGER
  41. dx AS INTEGER
  42. bp AS INTEGER
  43. si AS INTEGER
  44. di AS INTEGER
  45. flags AS INTEGER
  46. ds AS INTEGER
  47. es AS INTEGER
  48. END TYPE '20
  49.  
  50. REM $INCLUDE: 'qbtree50.bi'
  51.  
  52. DIM SHARED iregx AS RegTypex, oregx AS RegTypex
  53. DIM SHARED VideoSeg AS INTEGER
  54. DIM SHARED keyin AS INTEGER
  55. DIM SHARED MaxKeys AS INTEGER   '{keys to create...}
  56. DIM SHARED TestI AS INTEGER     '{do demo I if <> 0}
  57. DIM SHARED TestII AS INTEGER    '{do demo II if <> 0}
  58.  
  59. DECLARE SUB VECTORX (intnum%, iregx AS RegTypex, oregx AS RegTypex)
  60.  
  61. REDIM SHARED WinBuff(0 TO 80 * 25) AS INTEGER
  62.  
  63. MaxKeys = 500
  64. TestI = -1
  65. TestII = -1
  66. cmd$ = COMMAND$
  67. mx = INSTR(cmd$, "/K=")
  68. m1 = INSTR(cmd$, "/1=")
  69. m2 = INSTR(cmd$, "/2=")
  70. IF mx THEN MaxKeys = VAL(MID$(cmd$, mx + 3, 7))
  71. IF m1 THEN TestI = MID$(cmd$, m1 + 3, 1) <> "0"
  72. IF m2 THEN TestII = MID$(cmd$, m2 + 3, 1) <> "0"
  73. IF INSTR(cmd$, "?") THEN
  74.    PRINT
  75.    PRINT "DEMOQBT - a demonstration of QBTREE 5.0"
  76.    PRINT
  77.    PRINT CHR$(9); "/K=nnnnn     number of keys to use in the tests (default=500)"
  78.    PRINT CHR$(9); "/1=0         skip test I  (default=don't skip)"
  79.    PRINT CHR$(9); "/2=0         skip test II (default=don't skip)"
  80.    PRINT
  81.    SYSTEM
  82. END IF
  83. DoTitleScreen
  84. DoAboutPages
  85. IF keyin <> 27 THEN DoDemo
  86. COLOR 7, 0: LOCATE 25, 1: PRINT SPACE$(80);
  87. LOCATE 24, 1
  88. SYSTEM
  89.  
  90. FUNCTION Center (strg$, col, cols)
  91.  
  92. 'return the required column start for the string to be centered
  93. 'between column (col) to column (col+cols-1)
  94.  
  95. length = LEN(strg$)
  96. tc = col + (cols \ 2) - (length \ 2)
  97. IF tc > (80 - length) THEN tc = 80 - length
  98. IF tc < 1 THEN tc = 1
  99. Center = tc
  100.  
  101. END FUNCTION
  102.  
  103. SUB ClearMsgArea
  104.  
  105. COLOR 0, 0
  106. LOCATE 24, 22
  107. PRINT SPACE$(59);
  108. LOCATE 25, 22
  109. PRINT SPACE$(59);
  110. COLOR 15, 0
  111.  
  112. END SUB
  113.  
  114. SUB DelaySec (sec)
  115.  
  116. 'EXIT SUB
  117.  
  118. 'wait for sec seconds
  119. 'sec must be <= 60
  120. 'the current time and the (current time+sec) should not span
  121. 'MIDNIGHT else the routine exits without waiting
  122.  
  123. IF sec > 60 THEN EXIT SUB
  124. iregx.ax = &H2C00
  125. VECTORX &H21, iregx, oregx
  126. cursec = oregx.dx \ 256
  127. curmin = oregx.cx AND 255
  128. curhr = oregx.cx \ 256
  129. wait2hr = curhr
  130. wait2min = curmin
  131. wait2sec = cursec + sec
  132. IF wait2sec > 59 THEN
  133.    wait2min = curmin + 1
  134.    wait2sec = wait2sec - 60
  135.    IF wait2min > 59 THEN
  136.       wait2hr = curhr + 1
  137.       wait2min = wait2min - 60
  138.       IF wait2hr > 23 THEN nowait = -1
  139.    END IF
  140. END IF
  141. IF NOT nowait THEN
  142.    cmptime& = (10000& * wait2hr) + (wait2min * 100) + wait2sec
  143.    DO
  144.       VECTORX &H21, iregx, oregx
  145.       curtime& = 10000& * (oregx.cx \ 256) + (oregx.cx AND 255) * 100 + (oregx.dx \ 256)
  146.    LOOP UNTIL curtime& >= cmptime&
  147. END IF
  148.  
  149. END SUB
  150.  
  151. SUB DoAboutPages
  152.  
  153. COLOR 15, 5: LOCATE 5, 2: PRINT CHR$(16)
  154. row = 2: col = 4: rows = 21: cols = 74
  155. GetWindow row, col, rows, cols
  156. page2do = 0
  157. DO
  158.    SELECT CASE page2do
  159.    CASE 0
  160.       DoAboutPg0 row, col, rows, cols
  161.       GOSUB What2Do
  162.    CASE 1
  163.       DoAboutPg1 row, col, rows, cols
  164.       GOSUB What2Do
  165.    CASE 2
  166.       DoAboutPg2 row, col, rows, cols
  167.       GOSUB What2Do
  168.    CASE 3
  169.       DoAboutPg3 row, col, rows, cols
  170.       GOSUB What2Do
  171.    CASE 4
  172.       DoAboutPg4 row, col, rows, cols
  173.       GOSUB What2Do
  174.    CASE 5
  175.       DoAboutPg5 row, col, rows, cols
  176.       GOSUB What2Do
  177.    CASE 6
  178.       DoAboutPg6 row, col, rows, cols
  179.       GOSUB What2Do
  180.    CASE 7
  181.       DoAboutPg7 row, col, rows, cols
  182.       GOSUB What2Do
  183.    CASE 8
  184.       DoAboutPg8 row, col, rows, cols
  185.       GOSUB What2Do
  186.    CASE 9
  187.       DoAboutPg9 row, col, rows, cols
  188.       GOSUB What2Do
  189.    CASE ELSE
  190.    END SELECT
  191. LOOP UNTIL keyin = 27 OR keyin = 66
  192. PutWindow row, col
  193. COLOR 15, 5: LOCATE 5, 2: PRINT CHR$(251)
  194.  
  195. EXIT SUB
  196.  
  197. What2Do:
  198. SELECT CASE keyin
  199. CASE &H30 TO &H39
  200.    page2do = keyin - &H30
  201. CASE 1072, 1073
  202.    page2do = page2do - 1
  203.    IF page2do < 0 THEN page2do = 9
  204. CASE 1080, 1081
  205.    page2do = page2do + 1
  206.    IF page2do = 10 THEN page2do = 0
  207. CASE 1071
  208.    page2do = 0
  209. CASE 1079
  210.    page2do = 9
  211. CASE IS <> 27
  212.    page2do = page2do + 1
  213.    IF page2do = 10 THEN page2do = 0
  214. CASE ELSE
  215. END SELECT
  216. IF keyin = 27 AND page2do <> 0 THEN
  217.    page2do = 0
  218.    keyin = 255
  219. END IF
  220. RETURN
  221.  
  222. END SUB
  223.  
  224. SUB DoAboutPg0 (row, col, rows, cols)
  225.  
  226. 'page 0 about info
  227.  
  228. MakeWindow row, col, rows, cols, 7
  229. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  230. COLOR 15, 0
  231. title$ = "QBTREE 5.00"
  232. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  233. title$ = "A FILE ACCESS METHOD FOR QB/PDS PROGRAMMERS"
  234. LOCATE , Center(title$, col, cols): PRINT title$
  235. PRINT
  236. LOCATE , col + 29: PRINT "Table of Contents"
  237. COLOR 2, 0
  238. LOCATE , col + 29: PRINT STRING$(17, 196)
  239. COLOR 15, 0
  240. PRINT
  241. LOCATE , col + 5: PRINT "1. Technical Specifications"
  242. LOCATE , col + 5: PRINT "2. Initializing QBTREE and Creating Files"
  243. LOCATE , col + 5: PRINT "3. Opening, Closing and Flushing Files"
  244. LOCATE , col + 5: PRINT "4. Get Information About Key and Data Files"
  245. LOCATE , col + 5: PRINT "5. Adding to Key and Data Files"
  246. LOCATE , col + 5: PRINT "6. Getting from Key and Data Files"
  247. LOCATE , col + 5: PRINT "7. Storing and Retrieving from Key Files (Index-Only Manager)"
  248. LOCATE , col + 5: PRINT "8. Deleting from Key and Data Files"
  249. LOCATE , col + 5: PRINT "9. Network Support Routines"
  250. PRINT
  251. LOCATE , col + 8: PRINT "Press a number above, B to begin the demo, or Esc to quit"
  252. COLOR 0, 7
  253. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  254. keyin = GetKey(1)
  255.  
  256. END SUB
  257.  
  258. SUB DoAboutPg1 (row, col, rows, cols)
  259.  
  260. 'page 1 about info
  261.  
  262. MakeWindow row, col, rows, cols, 7
  263. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  264. COLOR 0, 7
  265. LOCATE row, (col + cols - 8): PRINT "Pg 1/9"
  266. COLOR 15, 0
  267. title$ = "Technical Specifications"
  268. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  269. title$ = STRING$(LEN(title$), 196)
  270. COLOR 2
  271. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  272. COLOR 15, 0
  273. PRINT
  274. LOCATE , col + 4: PRINT "Max keys/keyfile : ";
  275. COLOR 7, 0: PRINT " 5,504,940 keys (65,535 nodes)": COLOR 15, 0
  276. LOCATE , col + 4: PRINT "Max recs/datafile: ";
  277. COLOR 7, 0: PRINT "16,384,000 records": COLOR 15, 0
  278. PRINT
  279.  
  280. LOCATE , col + 4: PRINT "Max key length : ";
  281. COLOR 7, 0: PRINT "    64 bytes": COLOR 15, 0
  282. LOCATE , col + 4: PRINT "Max rec length : ";
  283. COLOR 7, 0: PRINT "32,767 bytes": COLOR 15, 0
  284. PRINT
  285. LOCATE , col + 4: PRINT "Max open key files : ";
  286. COLOR 7, 0: PRINT "250 files at one time": COLOR 15, 0
  287. LOCATE , col + 4: PRINT "Max open data files: ";
  288. COLOR 7, 0: PRINT "250 files at one time": COLOR 15, 0
  289. PRINT
  290.  
  291. LOCATE , col + 4: PRINT "Indexing algorithm: ";
  292. COLOR 7, 0: PRINT "proprietary B-TREE, ASCII sort": COLOR 15, 0
  293.  
  294. PRINT
  295. LOCATE , col + 4: PRINT "Complete specs and file formats are listed in the manual."
  296. COLOR 0, 7
  297. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  298. keyin = GetKey(1)
  299.  
  300. END SUB
  301.  
  302. SUB DoAboutPg2 (row, col, rows, cols)
  303.  
  304. 'page 2 about info
  305.  
  306. MakeWindow row, col, rows, cols, 7
  307. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  308. COLOR 0, 7
  309. LOCATE row, (col + cols - 8): PRINT "Pg 2/9"
  310. COLOR 15, 0
  311. title$ = "Initializing QBTREE and Creating Files"
  312. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  313. title$ = STRING$(LEN(title$), 196)
  314. COLOR 2
  315. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  316. COLOR 15, 0
  317. PRINT
  318. LOCATE , col + 4: PRINT "Allocate buffer areas (in far memory at runtime) and setup extended"
  319. LOCATE , col + 4: PRINT "file table to allow for up to 250 files to be opened at once. Also,"
  320. LOCATE , col + 4: PRINT "close all QBTREE files and release allocated memory."
  321. COLOR 7, 0
  322. PRINT
  323. LOCATE , col + 7: PRINT "status = InitQBTREE(MaxKeyFiles,MaxDataFiles)"
  324. LOCATE , col + 7: PRINT "status = ExitQBTREE()"
  325. COLOR 15, 0
  326. PRINT
  327. LOCATE , col + 4: PRINT "Create new key and data files."
  328. COLOR 7, 0
  329. PRINT
  330. LOCATE , col + 7: PRINT "status = CreateDataFile(pathname$,recordlength)"
  331. LOCATE , col + 7: PRINT "status = CreateKeyFile(pathname$,keylength)"
  332. COLOR 0, 7
  333. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  334. keyin = GetKey(1)
  335.  
  336. END SUB
  337.  
  338. SUB DoAboutPg3 (row, col, rows, cols)
  339.  
  340. 'page 3 about info
  341.  
  342. MakeWindow row, col, rows, cols, 7
  343. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  344. COLOR 0, 7
  345. LOCATE row, (col + cols - 8): PRINT "Pg 3/9"
  346. COLOR 15, 0
  347. title$ = "Opening, Closing and Flushing Files"
  348. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  349. title$ = STRING$(LEN(title$), 196)
  350. COLOR 2
  351. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  352. COLOR 15, 0
  353. PRINT
  354. LOCATE , col + 4: PRINT "Open and close QBTREE files."
  355. COLOR 7, 0
  356. PRINT
  357. LOCATE , col + 7: PRINT "status = OpenDataFile(pathname$,dfileno)"
  358. LOCATE , col + 7: PRINT "status = OpenKeyFile(pathname$,kfileno)"
  359. LOCATE , col + 7: PRINT "status = CloseDataFile(dfileno)"
  360. LOCATE , col + 7: PRINT "status = CloseKeyFile(kfileno)"
  361. COLOR 15, 0
  362. PRINT
  363. LOCATE , col + 4: PRINT "Physically write buffered data to disk and update the directory"
  364. LOCATE , col + 4: PRINT "entry without having to close and then reopen the files."
  365. COLOR 7, 0
  366. PRINT
  367. LOCATE , col + 7: PRINT "status = FlushDataFile(dfileno,dup)"
  368. LOCATE , col + 7: PRINT "status = FlushKeyFile(kfileno,dup)"
  369. PRINT
  370. COLOR 0, 7
  371. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  372. keyin = GetKey(1)
  373.  
  374. END SUB
  375.  
  376. SUB DoAboutPg4 (row, col, rows, cols)
  377.  
  378. 'page 4 about info
  379.  
  380. MakeWindow row, col, rows, cols, 7
  381. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  382. COLOR 0, 7
  383. LOCATE row, (col + cols - 8): PRINT "Pg 4/9"
  384. COLOR 15, 0
  385. title$ = "Get Information About Key and Data Files"
  386. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  387. title$ = STRING$(LEN(title$), 196)
  388. COLOR 2
  389. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  390. COLOR 15, 0
  391. PRINT
  392. LOCATE , col + 4: PRINT "Get information on an opened QBTREE file including the record or"
  393. LOCATE , col + 4: PRINT "key length, the number of records or keys in a file, and the BASIC"
  394. LOCATE , col + 4: PRINT "file number being used to access that file."
  395. COLOR 7, 0
  396. PRINT
  397. LOCATE , col + 7: PRINT "status = StatDataFile(dfileno,reclength,recs&,bfileno)"
  398. LOCATE , col + 7: PRINT "status = StatKeyFile(kfileno,keylength,keys&,bfileno)"
  399. COLOR 15, 0
  400. PRINT
  401. LOCATE , col + 4: PRINT "Get the last found key's data record pointer (record number)."
  402. COLOR 7, 0
  403. PRINT
  404. LOCATE , col + 7: PRINT "status = GetPosition(kfileno,recno&)"
  405. COLOR 0, 7
  406. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  407. keyin = GetKey(1)
  408.  
  409. END SUB
  410.  
  411. SUB DoAboutPg5 (row, col, rows, cols)
  412.  
  413. 'page 5 about info
  414.  
  415. MakeWindow row, col, rows, cols, 7
  416. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  417. COLOR 0, 7
  418. LOCATE row, (col + cols - 8): PRINT "Pg 5/9"
  419. COLOR 15, 0
  420. title$ = "Adding to Key and Data Files"
  421. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  422. title$ = STRING$(LEN(title$), 196)
  423. COLOR 2
  424. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  425. COLOR 15, 0
  426. PRINT
  427. LOCATE , col + 4: PRINT "Add (insert) a new key and data record to the key and data files."
  428. LOCATE , col + 4: PRINT "Also, add a key to a keyfile using the currently active data record"
  429. LOCATE , col + 4: PRINT "as its data pointer (record number)."
  430. COLOR 7, 0
  431. PRINT
  432. LOCATE , col + 7: PRINT "status = AddKeyRecord(kfile,dfile,Qkey$,Qrec$)"
  433. LOCATE , col + 7: PRINT "status = AddKey(kfile,dfile,Qkey$)"
  434. COLOR 15, 0
  435. PRINT
  436. LOCATE , col + 4: PRINT "Update the currently active data record."
  437. COLOR 7, 0
  438. PRINT
  439. LOCATE , col + 7: PRINT "status = UpdateRecord(dfile,Qrec$)"
  440. COLOR 0, 7
  441. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  442. keyin = GetKey(1)
  443.  
  444. END SUB
  445.  
  446. SUB DoAboutPg6 (row, col, rows, cols)
  447.  
  448. 'page 6 about info
  449.  
  450. MakeWindow row, col, rows, cols, 7
  451. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  452. COLOR 0, 7
  453. LOCATE row, (col + cols - 8): PRINT "Pg 6/9"
  454. COLOR 15, 0
  455. title$ = "Getting from Key and Data Files"
  456. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  457. title$ = STRING$(LEN(title$), 196)
  458. COLOR 2
  459. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  460. COLOR 15, 0
  461. PRINT
  462. LOCATE , col + 4: PRINT "Get the key equal to Qkey$ (or if not found the one following) and"
  463. LOCATE , col + 4: PRINT "return its data record, or, having already found a key, get either"
  464. LOCATE , col + 4: PRINT "the previous or next and return its key and data record. Also, get"
  465. LOCATE , col + 4: PRINT "the very first or very last key and data record."
  466. COLOR 7, 0
  467. PRINT
  468. LOCATE , col + 7: PRINT "status = GetEqual(kfile,dfile,Qkey$,Qrec$)"
  469. LOCATE , col + 7: PRINT "status = GetPrev(kfile,dfile,Qkey$,Qrec$)"
  470. LOCATE , col + 7: PRINT "status = GetNext(kfile,dfile,Qkey$,Qrec$)"
  471. LOCATE , col + 7: PRINT "status = GetFirst(kfile,dfile,Qkey$,Qrec$)"
  472. LOCATE , col + 7: PRINT "status = GetLast(kfile,dfile,Qkey$,Qrec$)"
  473. COLOR 15, 0
  474. PRINT
  475. LOCATE , col + 4: PRINT "Access a data record directly by record number."
  476. COLOR 7, 0
  477. PRINT
  478. LOCATE , col + 7: PRINT "status = GetDirect(dfileno,drecno&,Qrec$)"
  479. COLOR 0, 7
  480. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  481. keyin = GetKey(1)
  482.  
  483. END SUB
  484.  
  485. SUB DoAboutPg7 (row, col, rows, cols)
  486.  
  487. 'page 7 about info
  488.  
  489. MakeWindow row, col, rows, cols, 7
  490. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  491. COLOR 0, 7
  492. LOCATE row, (col + cols - 8): PRINT "Pg 7/9"
  493. COLOR 15, 0
  494. title$ = "Storing and Retrieving from Key Files (Index-Only Manager)"
  495. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  496. title$ = STRING$(LEN(title$), 196)
  497. COLOR 2
  498. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  499. COLOR 15, 0
  500. PRINT
  501. LOCATE , col + 4: PRINT "Store the key and record number in kfile."
  502. COLOR 7, 0
  503. PRINT
  504. LOCATE , col + 7: PRINT "status = StoreKey(kfile,Qkey$,Qurecno&)"
  505. COLOR 15, 0
  506. PRINT
  507. LOCATE , col + 4: PRINT "Get the key equal to Qkey$ (or if not found the one following) and"
  508. LOCATE , col + 4: PRINT "return its record number, or, having already found a key, get either"
  509. LOCATE , col + 4: PRINT "the previous or next and return its key and record number. Also, get"
  510. LOCATE , col + 4: PRINT "the very first or very last key and record number."
  511. COLOR 7, 0
  512. PRINT
  513. LOCATE , col + 7: PRINT "status = RetrieveEqual(kfile,Qkey$,Qurecno&)"
  514. LOCATE , col + 7: PRINT "status = RetrievePrev(kfile,Qkey$,Qurecno&)"
  515. LOCATE , col + 7: PRINT "status = RetrieveNext(kfile,Qkey$,Qurecno&)"
  516. LOCATE , col + 7: PRINT "status = RetrieveFirst(kfile,Qkey$,Qurecno&)"
  517. LOCATE , col + 7: PRINT "status = RetrieveLast(kfile,Qkey$,Qurecno&)"
  518. COLOR 0, 7
  519. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  520. keyin = GetKey(1)
  521.  
  522. END SUB
  523.  
  524. SUB DoAboutPg8 (row, col, rows, cols)
  525.  
  526. 'page 8 about info
  527.  
  528. MakeWindow row, col, rows, cols, 7
  529. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  530. COLOR 0, 7
  531. LOCATE row, (col + cols - 8): PRINT "Pg 8/9"
  532. COLOR 15, 0
  533. title$ = "Deleting from Key and Data Files"
  534. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  535. title$ = STRING$(LEN(title$), 196)
  536. COLOR 2
  537. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  538. COLOR 15, 0
  539. PRINT
  540. LOCATE , col + 4: PRINT "Delete the key from the key file."
  541. COLOR 7, 0
  542. PRINT
  543. LOCATE , col + 7: PRINT "status = DeleteKey(kfile,Qkey$)"
  544. COLOR 15, 0
  545. PRINT
  546. LOCATE , col + 4: PRINT "Delete the key from the key file and also the data record that it"
  547. LOCATE , col + 4: PRINT "points to from the data file."
  548. COLOR 7, 0
  549. PRINT
  550. LOCATE , col + 7: PRINT "status = DeleteKeyRecord(kfile,dfile,Qkey$)"
  551. COLOR 0, 7
  552. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  553. keyin = GetKey(1)
  554.  
  555. END SUB
  556.  
  557. SUB DoAboutPg9 (row, col, rows, cols)
  558.  
  559. 'page 9 about info
  560.  
  561. MakeWindow row, col, rows, cols, 7
  562. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  563. COLOR 0, 7
  564. LOCATE row, (col + cols - 8): PRINT "Pg 9/9"
  565. COLOR 15, 0
  566. title$ = "Network Support Routines"
  567. LOCATE row + 2, Center(title$, col, cols): PRINT title$
  568. title$ = STRING$(LEN(title$), 196)
  569. COLOR 2
  570. LOCATE row + 3, Center(title$, col, cols): PRINT title$
  571. COLOR 15, 0
  572. PRINT
  573. LOCATE , col + 4: PRINT "Load key and data file headers."
  574. LOCATE , col + 4: PRINT "Lock and unlock key and data files and records."
  575. COLOR 7, 0
  576. PRINT
  577. LOCATE , col + 7: PRINT "stat = LoadDataHeader(dfile)"
  578. LOCATE , col + 7: PRINT "stat = LoadKeyHeader(kfile)"
  579. LOCATE , col + 7: PRINT "stat = LockDataHeader(dfile)"
  580. LOCATE , col + 7: PRINT "stat = LockKeyFile(kfile)"
  581. LOCATE , col + 7: PRINT "stat = LockRecord(dfile,recno&)"
  582. LOCATE , col + 7: PRINT "stat = UnlockDataHeader(dfile)"
  583. LOCATE , col + 7: PRINT "stat = UnlockKeyFile(kfile)"
  584. LOCATE , col + 7: PRINT "stat = UnlockRecord(dfile,recno&)"
  585. COLOR 0, 7
  586. LOCATE row + rows - 1, col + cols - 9: PRINT "more...";
  587. keyin = GetKey(1)
  588.  
  589. END SUB
  590.  
  591. SUB DoAddReadII
  592.  
  593. row = 4: col = 22: rows = 16: cols = 18
  594. COLOR 15, 5: LOCATE 15, 2: PRINT CHR$(16)
  595. ClearMsgArea
  596. LOCATE 24, 22: COLOR 15, 0
  597. PRINT "Adding"; MaxKeys; "rnd 7-byte keys to "; CHR$(34); "KEYONE.II"; CHR$(34); ","; MaxKeys; "rnd 8-";
  598. LOCATE 25, 22
  599. PRINT "byte keys to "; CHR$(34); "KEYTWO.II"; CHR$(34); ","; MaxKeys; "16-byte recs to "; CHR$(34); "DATA.II"; CHR$(34);
  600. cnt = 0
  601. prnrow = 3
  602. COLOR 15, 1
  603. DO
  604.    keynum1$ = CHR$(65 + (RND * 25)) + LTRIM$(STR$(INT(RND * 899) + 100)) + LTRIM$(STR$(INT(RND * 899) + 100))
  605.    keynum2$ = CHR$(65 + (RND * 25)) + LTRIM$(STR$(INT(RND * 899) + 100)) + LTRIM$(STR$(INT(RND * 899) + 100)) + "*"
  606.    Qrec$ = keynum1$ + "-" + keynum2$
  607.    stat = AddKeyRecord(0, 0, keynum1$, Qrec$)
  608.    IF stat = 0 THEN stat = AddKey(1, 0, keynum2$)
  609.    IF stat = 0 THEN
  610.       prnrow = prnrow + 1
  611.       IF prnrow > 19 THEN
  612.          ScrollWindow row, col, rows, cols, 1, 1
  613.          ScrollWindow row, col + 20, rows, cols, 1, 1
  614.          ScrollWindow row, col + 40, rows, cols, 1, 1
  615.          prnrow = 19
  616.       END IF
  617.       LOCATE prnrow, 23
  618.       PRINT keynum1$;
  619.       LOCATE prnrow, 43
  620.       PRINT keynum2$;
  621.       LOCATE prnrow, 63
  622.       PRINT Qrec$;
  623.       cnt = cnt + 1
  624.    ELSEIF stat <> 201 THEN
  625.       nul = CloseKeyFile(0)
  626.       nul = CloseKeyFile(1)
  627.       nul = CloseDataFile(0)
  628.       ShowErrorMsg stat
  629.    END IF
  630. LOOP UNTIL cnt >= MaxKeys
  631.  
  632. DelaySec 2
  633. ScrollWindow row, col, rows, cols, 1, 0 '{clear window}
  634. ScrollWindow row, col + 20, rows, cols, 1, 0
  635. ScrollWindow row, col + 40, rows, cols, 1, 0
  636. ClearMsgArea
  637. LOCATE 24, 22: COLOR 15, 0
  638. PRINT "Reading the data records indexed by "; CHR$(34); "KEYONE.II"; CHR$(34);
  639. prnrow = 3
  640. COLOR 15, 1
  641. stat = GetFirst(0, 0, Qkey$, Qrec$)
  642. DO WHILE stat = 0
  643.    prnrow = prnrow + 1
  644.    IF prnrow > 19 THEN
  645.       ScrollWindow row, col, rows, cols, 1, 1
  646.       ScrollWindow row, col + 40, rows, cols, 1, 1
  647.       prnrow = 19
  648.    END IF
  649.    LOCATE prnrow, 23
  650.    PRINT Qkey$;
  651.    LOCATE prnrow, 63
  652.    PRINT Qrec$;
  653.    stat = GetNext(0, 0, Qkey$, Qrec$)
  654. LOOP
  655. DelaySec 2
  656.  
  657. ScrollWindow row, col, rows, cols, 1, 0 '{clear window}
  658. ScrollWindow row, col + 40, rows, cols, 1, 0
  659. ClearMsgArea
  660. LOCATE 24, 22: COLOR 15, 0
  661. PRINT "Reading the same data records indexed by "; CHR$(34); "KEYTWO.II"; CHR$(34);
  662. prnrow = 3
  663. COLOR 15, 1
  664. stat = GetFirst(1, 0, Qkey$, Qrec$)
  665. DO WHILE stat = 0
  666.    prnrow = prnrow + 1
  667.    IF prnrow > 19 THEN
  668.       ScrollWindow row, col + 20, rows, cols, 1, 1
  669.       ScrollWindow row, col + 40, rows, cols, 1, 1
  670.       prnrow = 19
  671.    END IF
  672.    LOCATE prnrow, 43
  673.    PRINT Qkey$;
  674.    LOCATE prnrow, 63
  675.    PRINT Qrec$;
  676.    stat = GetNext(1, 0, Qkey$, Qrec$)
  677. LOOP
  678. DelaySec 2
  679.  
  680. COLOR 15, 5: LOCATE 15, 2: PRINT CHR$(251)
  681.  
  682. END SUB
  683.  
  684. SUB DoCloseI
  685.  
  686. COLOR 15, 5: LOCATE 13, 2: PRINT CHR$(16)
  687. ClearMsgArea
  688. LOCATE 24, 22: COLOR 15, 0
  689. PRINT "Closing "; CHR$(34); "KEYONE.I"; CHR$(34);
  690. stat = CloseKeyFile(0)
  691. IF stat THEN ShowErrorMsg stat
  692. DelaySec 1
  693. COLOR 15, 5: LOCATE 13, 2: PRINT CHR$(251)
  694.  
  695. END SUB
  696.  
  697. SUB DoCloseII
  698.  
  699. COLOR 15, 5: LOCATE 17, 2: PRINT CHR$(16)
  700.  
  701. ClearMsgArea
  702. LOCATE 24, 22: COLOR 15, 0
  703. PRINT "Closing "; CHR$(34); "KEYONE.II"; CHR$(34);
  704. stat = CloseKeyFile(0)
  705. IF stat THEN ShowErrorMsg stat
  706. DelaySec 1
  707.  
  708. ClearMsgArea
  709. LOCATE 24, 22: COLOR 15, 0
  710. PRINT "Closing "; CHR$(34); "KEYTWO.II"; CHR$(34);
  711. stat = CloseKeyFile(1)
  712. IF stat THEN ShowErrorMsg stat
  713. DelaySec 1
  714.  
  715. ClearMsgArea
  716. LOCATE 24, 22: COLOR 15, 0
  717. PRINT "Closing "; CHR$(34); "DATA.II"; CHR$(34);
  718. stat = CloseDataFile(0)
  719. IF stat THEN ShowErrorMsg stat
  720. DelaySec 1
  721.  
  722. COLOR 15, 5: LOCATE 17, 2: PRINT CHR$(251)
  723.  
  724. END SUB
  725.  
  726. SUB DoCreateOpenI
  727.  
  728. COLOR 15, 5: LOCATE 10, 2: PRINT CHR$(16)
  729. ClearMsgArea
  730. LOCATE 24, 22: COLOR 15, 0
  731. IF FileExists("KEYONE.I") THEN KILL "KEYONE.I"
  732. PRINT "Creating and opening "; CHR$(34); "KEYONE.I"; CHR$(34);
  733. stat = CreateKeyFile("KEYONE.I", 9)
  734. IF stat THEN ShowErrorMsg stat
  735. stat = OpenKeyFile("KEYONE.I", 0)
  736. IF stat THEN ShowErrorMsg stat
  737. COLOR 15, 1: LOCATE 2, 29: PRINT "KEYONE.I"
  738. DelaySec 1
  739. COLOR 15, 5: LOCATE 10, 2: PRINT CHR$(251)
  740.  
  741. END SUB
  742.  
  743. SUB DoCreateOpenII
  744.  
  745. row = 4: col = 22: rows = 16: cols = 18
  746. COLOR 15, 5: LOCATE 14, 2: PRINT CHR$(16)
  747.  
  748. ClearMsgArea
  749. ScrollWindow row, col, rows, cols, 1, 0 '{clear window}
  750. ScrollWindow row, col + 20, rows, cols, 1, 0
  751. ScrollWindow row, col + 40, rows, cols, 1, 0
  752. LOCATE 24, 22: COLOR 15, 0
  753. IF FileExists("KEYONE.II") THEN KILL "KEYONE.II"
  754. PRINT "Creating and opening "; CHR$(34); "KEYONE.II"; CHR$(34);
  755. stat = CreateKeyFile("KEYONE.II", 7)
  756. IF stat THEN ShowErrorMsg stat
  757. stat = OpenKeyFile("KEYONE.II", 0)
  758. IF stat THEN ShowErrorMsg stat
  759. COLOR 15, 1: LOCATE 2, 29: PRINT "KEYONE.II"
  760. DelaySec 1
  761.  
  762. ClearMsgArea
  763. LOCATE 24, 22: COLOR 15, 0
  764. IF FileExists("KEYTWO.II") THEN KILL "KEYTWO.II"
  765. PRINT "Creating and opening "; CHR$(34); "KEYTWO.II"; CHR$(34);
  766. stat = CreateKeyFile("KEYTWO.II", 8)
  767. IF stat THEN ShowErrorMsg stat
  768. stat = OpenKeyFile("KEYTWO.II", 1)
  769. IF stat THEN ShowErrorMsg stat
  770. COLOR 15, 1: LOCATE 2, 49: PRINT "KEYTWO.II"
  771. DelaySec 1
  772.  
  773. ClearMsgArea
  774. LOCATE 24, 22: COLOR 15, 0
  775. IF FileExists("DATA.II") THEN KILL "DATA.II"
  776. PRINT "Creating and opening "; CHR$(34); "DATA.II"; CHR$(34);
  777. stat = CreateDataFile("DATA.II", 16)
  778. IF stat THEN ShowErrorMsg stat
  779. stat = OpenDataFile("DATA.II", 0)
  780. IF stat THEN ShowErrorMsg stat
  781. COLOR 15, 1: LOCATE 2, 69: PRINT "DATA.II"
  782. DelaySec 1
  783.  
  784. COLOR 15, 5: LOCATE 14, 2: PRINT CHR$(251)
  785.  
  786. END SUB
  787.  
  788. SUB DoDeleteReadI
  789.  
  790. row = 4: col = 22: rows = 16: cols = 18
  791. COLOR 15, 5: LOCATE 12, 2: PRINT CHR$(16)
  792. ClearMsgArea
  793. LOCATE 24, 22: COLOR 15, 0
  794. PRINT "Deleting every other key in "; CHR$(34); "KEYONE.I"; CHR$(34);
  795. cnt = 0
  796. prnrow = 3
  797. COLOR 15, 1
  798. stat = RetrieveFirst(0, Qkey$, Qurecno&)
  799. DO WHILE stat = 0
  800.    stat = RetrieveNext(0, Qkey$, Qurecno&)
  801.    IF stat = 0 THEN stat = DeleteKey(0, Qkey$)
  802.    IF stat = 0 THEN stat = RetrieveNext(0, Qkey$, Qurecno&)
  803. LOOP
  804. DelaySec 2
  805. ScrollWindow row, col, rows, cols, 1, 0 '{clear window}
  806. ClearMsgArea
  807. LOCATE 24, 22: COLOR 15, 0
  808. PRINT "Reading the remaining keys from "; CHR$(34); "KEYONE.I"; CHR$(34);
  809. prnrow = 3
  810. COLOR 15, 1
  811. stat = RetrieveFirst(0, Qkey$, Qurecno&)
  812. DO WHILE stat = 0
  813.    prnrow = prnrow + 1
  814.    IF prnrow > 19 THEN
  815.       ScrollWindow row, col, rows, cols, 1, 1
  816.       prnrow = 19
  817.    END IF
  818.    LOCATE prnrow, 23
  819.    PRINT Qkey$;
  820.    stat = RetrieveNext(0, Qkey$, Qurecno&)
  821. LOOP
  822. DelaySec 2
  823. COLOR 15, 5: LOCATE 12, 2: PRINT CHR$(251)
  824.  
  825. END SUB
  826.  
  827. SUB DoDeleteReadII
  828.  
  829. row = 4: col = 22: rows = 16: cols = 18
  830. COLOR 15, 5: LOCATE 16, 2: PRINT CHR$(16)
  831. ClearMsgArea
  832. LOCATE 24, 22: COLOR 15, 0
  833. PRINT "Deleting every third key in "; CHR$(34); "KEYTWO.II"; CHR$(34); " and its data";
  834. LOCATE 25, 22
  835. PRINT "record in "; CHR$(34); "DATA.II"; CHR$(34);
  836. cnt = 0
  837. prnrow = 3
  838. COLOR 15, 1
  839. stat = GetFirst(1, 0, Qkey$, Qrec$)
  840. DO WHILE stat = 0
  841.    stat = GetNext(1, 0, Qkey$, Qrec$)
  842.    IF stat = 0 THEN stat = GetNext(1, 0, Qkey$, Qrec$)
  843.    IF stat = 0 THEN stat = DeleteKeyRecord(1, 0, Qkey$)
  844.    stat = GetNext(1, 0, Qkey$, Qrec$)
  845. LOOP
  846. DelaySec 2
  847. ScrollWindow row, col + 20, rows, cols, 1, 0'{clear window}
  848. ScrollWindow row, col + 40, rows, cols, 1, 0
  849. ClearMsgArea
  850. LOCATE 24, 22: COLOR 15, 0
  851. PRINT "Reading the remaining keys from "; CHR$(34); "KEYTWO.II"; CHR$(34); " and its data";
  852. LOCATE 25, 22
  853. PRINT "from "; CHR$(34); "DATA.II"; CHR$(34); " in REVERSE";
  854. prnrow = 20
  855. COLOR 15, 1
  856. stat = GetLast(1, 0, Qkey$, Qrec$)
  857. DO WHILE stat = 0
  858.    prnrow = prnrow - 1
  859.    IF prnrow < 4 THEN
  860.       ScrollWindow row, col + 20, rows, cols, 1, -1
  861.       ScrollWindow row, col + 40, rows, cols, 1, -1
  862.       prnrow = 4
  863.    END IF
  864.    LOCATE prnrow, 43
  865.    PRINT Qkey$;
  866.    LOCATE prnrow, 63
  867.    PRINT Qrec$;
  868.    stat = GetPrev(1, 0, Qkey$, Qrec$)
  869. LOOP
  870. DelaySec 3
  871. COLOR 15, 5: LOCATE 16, 2: PRINT CHR$(251)
  872.  
  873. END SUB
  874.  
  875. SUB DoDemo
  876.  
  877. DoInitQBTREE
  878. IF TestI THEN
  879.    DoCreateOpenI
  880.    DoStoreReadI
  881.    DoDeleteReadI
  882.    DoCloseI
  883. END IF
  884. IF TestII THEN
  885.    DoCreateOpenII
  886.    DoAddReadII
  887.    DoDeleteReadII
  888.    DoCloseII
  889. END IF
  890.  
  891. END SUB
  892.  
  893. SUB DoInitQBTREE
  894.  
  895. COLOR 15, 5: LOCATE 9, 2: PRINT CHR$(16)
  896. ClearMsgArea
  897. LOCATE 24, 22: COLOR 15, 0
  898. PRINT "Allocating buffer areas for 2 key and 1 data file.";
  899. stat = InitQBTREE(2, 1)         '{actually, this is 3 key and 2 data!}
  900. IF stat THEN ShowErrorMsg stat
  901. DelaySec 2
  902. COLOR 15, 5: LOCATE 9, 2: PRINT CHR$(251)
  903.  
  904. END SUB
  905.  
  906. SUB DoStoreReadI
  907.  
  908. row = 4: col = 22: rows = 16: cols = 18
  909. COLOR 15, 5: LOCATE 11, 2: PRINT CHR$(16)
  910. ClearMsgArea
  911. LOCATE 24, 22: COLOR 15, 0
  912. PRINT "Storing"; MaxKeys; "rnd 9-byte keys to "; CHR$(34); "KEYONE.I"; CHR$(34);
  913. cnt = 0
  914. prnrow = 3
  915. COLOR 15, 1
  916. DO
  917.    keynum$ = CHR$(65 + (RND * 25)) + LTRIM$(STR$(INT(RND * 8999) + 1000)) + LTRIM$(STR$(INT(RND * 8999) + 1000))
  918.    stat = StoreKey(0, keynum$, CLNG(cnt))
  919.    IF stat = 0 THEN
  920.       prnrow = prnrow + 1
  921.       IF prnrow > 19 THEN
  922.          ScrollWindow row, col, rows, cols, 1, 1
  923.          prnrow = 19
  924.       END IF
  925.       LOCATE prnrow, 23
  926.       PRINT keynum$;
  927.       cnt = cnt + 1
  928.    ELSEIF stat <> 201 THEN
  929.       nul = CloseKeyFile(0)
  930.       ShowErrorMsg stat
  931.    END IF
  932. LOOP UNTIL cnt >= MaxKeys
  933. DelaySec 2
  934. ScrollWindow row, col, rows, cols, 1, 0 '{clear window}
  935. ClearMsgArea
  936. LOCATE 24, 22: COLOR 15, 0
  937. PRINT "Reading the stored keys from "; CHR$(34); "KEYONE.I"; CHR$(34);
  938. prnrow = 3
  939. COLOR 15, 1
  940. stat = RetrieveFirst(0, Qkey$, Qurecno&)
  941. DO WHILE stat = 0
  942.    prnrow = prnrow + 1
  943.    LOCATE prnrow, 23
  944.    IF prnrow > 19 THEN
  945.       ScrollWindow row, col, rows, cols, 1, 1
  946.       prnrow = 19
  947.       LOCATE prnrow, 23
  948.    END IF
  949.    PRINT Qkey$;
  950.    stat = RetrieveNext(0, Qkey$, Qurecno&)
  951. LOOP
  952. DelaySec 2
  953. COLOR 15, 5: LOCATE 11, 2: PRINT CHR$(251)
  954.  
  955. END SUB
  956.  
  957. SUB DoTitleScreen
  958.  
  959. DEF SEG = 0
  960. CRTC = PEEK(&H463)
  961. DEF SEG
  962. IF CRTC = &HD4 THEN VideoSeg = &HB800 ELSE VideoSeg = &HB000
  963.  
  964. CLS
  965. LOCATE , , 0
  966. row = 1: col = 1: rows = 22: cols = 20: fg = 15: bg = 5
  967. MakeWindow row, col, rows, cols, bg
  968. COLOR fg, bg
  969. title$ = "QBTREE 5.00 DEMO"
  970. LOCATE row + 1, Center(title$, col, cols)
  971. PRINT title$;
  972. PRINT
  973. PRINT " "; STRING$(18, 196)
  974. PRINT
  975. PRINT "   About QBTREE"
  976. PRINT
  977. PRINT " "; STRING$(18, 196)
  978. PRINT
  979. PRINT "  1. Init QBTREE"
  980. PRINT "  2. Create/Open I"
  981. PRINT "  3. Store/Read"
  982. PRINT "  4. Delete/Read"
  983. PRINT "  5. Close"
  984. PRINT "  6. Create/Open II"
  985. PRINT "  7. Add/Read"
  986. PRINT "  8. Delete/Read"
  987. PRINT "  9. Close"
  988. PRINT
  989. PRINT
  990. PRINT " "; STRING$(18, 196)
  991. PRINT "   (C)1991 by"
  992. PRINT "      Cornel Huth"
  993. COLOR 5, 1
  994. PRINT STRING$(20, 223)
  995. PRINT STRING$(20, 223);
  996. LOCATE 25, 1
  997. PRINT STRING$(20, 223);
  998.       
  999. row = 1: col = 21: rows = 22: cols = 60: fg = 15: bg = 1
  1000. COLOR fg
  1001. MakeWindow row, col, rows, cols, bg
  1002. LOCATE row + 1, 23: PRINT "File:"
  1003. LOCATE row + 1, 43: PRINT "File:"
  1004. LOCATE row + 1, 63: PRINT "File:"
  1005. LOCATE row + 2, 22: PRINT STRING$(17, 196)
  1006. LOCATE row + 2, 42: PRINT STRING$(17, 196)
  1007. LOCATE row + 2, 62: PRINT STRING$(17, 196)
  1008. FOR i = row + 1 TO rows + 2
  1009.    LOCATE i, 40: PRINT CHR$(179);
  1010.    LOCATE i, 60: PRINT CHR$(179);
  1011. NEXT
  1012. LOCATE row + 19, 22: PRINT STRING$(17, 196)
  1013. LOCATE row + 19, 42: PRINT STRING$(17, 196)
  1014. LOCATE row + 19, 62: PRINT STRING$(17, 196)
  1015.  
  1016. COLOR 1, 0
  1017. LOCATE 23, 21
  1018. PRINT STRING$(60, 223)
  1019. row = 24: col = 21: rows = 2: cols = 60: fg = 15: bg = 0
  1020. COLOR fg
  1021. MakeWindow row, col, rows, cols, bg
  1022. COLOR 15, 0
  1023. LOCATE 24, 22
  1024. drv$ = CHR$(GetDefaultDrive)
  1025. PRINT drv$; ": has";
  1026. GetDiskInfo drv$, AvailClusters, MaxClusters, BytesSector, SecCluster, freebytes&
  1027. PRINT freebytes&; "of"; (1& * MaxClusters * SecCluster * BytesSector); "bytes free using"; BytesSector;
  1028. LOCATE , POS(0) - 1
  1029. PRINT "-byte";
  1030. LOCATE 25, 22
  1031. KC = (SecCluster * BytesSector) \ 1024
  1032. IF KC >= 1 THEN
  1033.    PRINT "sectors and"; KC;
  1034.    LOCATE , POS(0) - 1
  1035. ELSE
  1036.    PRINT "sectors and ½ ";    '{HD disks have 1 sector / cluster}
  1037. END IF
  1038. PRINT "K clusters with";
  1039. PRINT AvailClusters; "of"; MaxClusters; "clusters free";
  1040. DelaySec 2
  1041. akey = SignalMessage("Press <Enter> to begin", 1)
  1042. IF akey = 27 THEN
  1043.    COLOR 7, 0: LOCATE 25, 1: PRINT SPACE$(80);
  1044.    LOCATE 24, 1
  1045.    SYSTEM
  1046. END IF
  1047.  
  1048. END SUB
  1049.  
  1050. FUNCTION GetKey (waitfor)
  1051.  
  1052. 'if waitfor <> 0 then wait until a key is struck
  1053. 'else check just once - the ASCII code is returned,
  1054. 'e.g., press A returns 65, a=97...extended keys such
  1055. 'as the cursor and function keys return the code+1000,
  1056. 'e.g, press F1 returns 1059, shift-F1=1084...
  1057.  
  1058. LOCATE , , 1
  1059. DO: LOOP WHILE INKEY$ <> ""
  1060. k = 0
  1061. DO
  1062.    k$ = UCASE$(INKEY$)
  1063.    IF LEN(k$) = 2 THEN
  1064.       k = 1000 + ASC(RIGHT$(k$, 1))
  1065.    ELSEIF LEN(k$) = 1 THEN
  1066.       k = ASC(k$)
  1067.    END IF
  1068. LOOP WHILE k = 0 AND waitfor
  1069. GetKey = k
  1070. LOCATE , , 0
  1071.  
  1072. END FUNCTION
  1073.  
  1074. SUB GetWindow (row, col, rows, cols)
  1075.  
  1076. 'assume a standard 80-column text mode
  1077.  
  1078. IF rows > 25 OR cols > 80 THEN STOP
  1079.  
  1080. BuffSeg = VARSEG(WinBuff(0)): BuffOff = VARPTR(WinBuff(0))
  1081. row0 = row - 1
  1082. row1 = row0 + rows - 1
  1083. col0 = col - 1
  1084. col1 = col0 + cols - 1
  1085.  
  1086. skipbytes = (col0 + (79 - col1)) * 2
  1087. vaddr = row0 * 160 + (col0 * 2)
  1088.  
  1089. baddr = BuffOff
  1090. DEF SEG = BuffSeg
  1091. POKE baddr, rows
  1092. POKE baddr + 1, cols
  1093. baddr = baddr + 2
  1094.  
  1095. FOR i = row0 TO row1
  1096.    FOR j = col0 TO col1
  1097.      
  1098.       DEF SEG = VideoSeg
  1099.       byte1 = PEEK(vaddr)
  1100.       byte2 = PEEK(vaddr + 1)
  1101.       vaddr = vaddr + 2
  1102.      
  1103.       DEF SEG = BuffSeg
  1104.       POKE baddr, byte1
  1105.       POKE baddr + 1, byte2
  1106.       baddr = baddr + 2
  1107.  
  1108.    NEXT
  1109.    vaddr = vaddr + skipbytes
  1110. NEXT
  1111. DEF SEG
  1112.  
  1113. END SUB
  1114.  
  1115. SUB MakeWindow (row, col, rows, cols, bg)
  1116.  
  1117. 'changes fg color to black so we exit with fg=15
  1118.  
  1119. COLOR 0, bg
  1120. IF bg <> 7 THEN
  1121.    FOR i = row TO (row + rows - 1)
  1122.       LOCATE i, col
  1123.       PRINT SPACE$(cols);
  1124.    NEXT
  1125. ELSE
  1126.    LOCATE row, col
  1127.    PRINT SPACE$(cols);
  1128.    FOR i = row + 1 TO (row + rows - 1)
  1129.       LOCATE i, col
  1130.       PRINT SPACE$(1);
  1131.       LOCATE i, (col + cols - 1)
  1132.       PRINT SPACE$(1);
  1133.    NEXT
  1134.    LOCATE , col
  1135.    PRINT SPACE$(cols);
  1136. END IF
  1137. COLOR 15
  1138.  
  1139. END SUB
  1140.  
  1141. SUB PutWindow (row, col)
  1142.  
  1143. 'assume a standard 80-column text mode
  1144.  
  1145. BuffSeg = VARSEG(WinBuff(0)): BuffOff = VARPTR(WinBuff(0))
  1146.  
  1147. baddr = BuffOff
  1148. DEF SEG = BuffSeg
  1149. rows = PEEK(baddr)
  1150. cols = PEEK(baddr + 1)
  1151. baddr = baddr + 2
  1152.  
  1153. row0 = row - 1
  1154. row1 = row0 + rows - 1
  1155. col0 = col - 1
  1156. col1 = col0 + cols - 1
  1157.  
  1158. skipbytes = (col0 + (79 - col1)) * 2
  1159. vaddr = row0 * 160 + (col0 * 2)
  1160.  
  1161. FOR i = row0 TO row1
  1162.    FOR j = col0 TO col1
  1163.    
  1164.       DEF SEG = BuffSeg
  1165.       byte1 = PEEK(baddr)
  1166.       byte2 = PEEK(baddr + 1)
  1167.       baddr = baddr + 2
  1168.  
  1169.       DEF SEG = VideoSeg
  1170.       POKE vaddr, byte1
  1171.       POKE vaddr + 1, byte2
  1172.       vaddr = vaddr + 2
  1173.   
  1174.    NEXT
  1175.    vaddr = vaddr + skipbytes
  1176. NEXT
  1177. DEF SEG
  1178.  
  1179. END SUB
  1180.  
  1181. SUB ScrollWindow (row, col, rows, cols, lines, dir)
  1182.  
  1183. row0 = row - 1
  1184. row1 = row0 + rows - 1
  1185. col0 = col - 1
  1186. col1 = col0 + cols - 1
  1187. attr = SCREEN(row, col, 1)
  1188.  
  1189. IF dir > 0 THEN
  1190.    iregx.ax = &H6 * 256 + lines  'scroll contents up
  1191.    attr = SCREEN(row1, col, 1)
  1192. ELSEIF dir < 0 THEN
  1193.    iregx.ax = &H7 * 256 + lines  'down
  1194. ELSE
  1195.    iregx.ax = &H600              'clr window
  1196. END IF
  1197.  
  1198. iregx.bx = attr * 256
  1199. iregx.cx = row0 * 256 + col0
  1200. iregx.dx = row1 * 256 + col1
  1201.    
  1202. VECTORX &H10, iregx, oregx
  1203.  
  1204. END SUB
  1205.  
  1206. SUB ShowErrorMsg (stat)
  1207.  
  1208. COLOR 15, 0: LOCATE 25, 22
  1209. PRINT "QBTREE error:"; stat;
  1210. BEEP
  1211. DelaySec 4
  1212. PRINT
  1213. LOCATE , 22
  1214. PRINT "This demo has met with fatal error"; stat; "and is quitting."
  1215. PRINT
  1216. SYSTEM
  1217.  
  1218. END SUB
  1219.  
  1220. FUNCTION SignalMessage (msg$, waitfor)
  1221.  
  1222. row = 10: col = 40 - (LEN(msg$) \ 2): rows = 5: cols = LEN(msg$) + 6
  1223. GetWindow row, col, rows, cols
  1224. MakeWindow row, col, rows, cols, 7
  1225. MakeWindow row + 1, col + 1, rows - 2, cols - 2, 0
  1226. LOCATE row + 2, Center(msg$, col, cols)
  1227. COLOR 15, 0
  1228. PRINT msg$;
  1229. SignalMessage = GetKey(waitfor)
  1230. PutWindow row, col
  1231.  
  1232. END FUNCTION
  1233.  
  1234.